Over 1,000 Windows 95 Programs/Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso/1471/frmmain.frm

Visual Basic Form | 1997-02-11 | 15.0 KB | 472 lines

VERSION 4.00
Begin VB.Form frmMain
   Caption         =   "ThreadView Sample Application"
   ClientHeight    =   5784
   ClientLeft      =   3612
   ClientTop       =   1896
   ClientWidth     =   6552
   Height          =   6168
   Left            =   3564
   LinkTopic       =   "Form1"
   ScaleHeight     =   5784
   ScaleWidth      =   6552
   Top             =   1560
   Width           =   6648
   Begin VB.PictureBox picCmdCenter
      Height          =   828
      Left            =   96
      ScaleHeight     =   780
      ScaleWidth      =   6300
      TabIndex        =   4
      Top             =   2940
      Visible         =   0   'False
      Width           =   6348
      Begin VB.TextBox txtSelect
         Height          =   288
         Left            =   4128
         TabIndex        =   14
         Text            =   "1"
         Top             =   60
         Width           =   588
      End
      Begin VB.TextBox txtDeselect
         Height          =   288
         Left            =   4128
         TabIndex        =   13
         Text            =   "1"
         Top             =   420
         Width           =   588
      End
      Begin VB.CommandButton cmdDeselect
         Caption         =   "Deselect"
         Height          =   312
         Left            =   4824
         TabIndex        =   12
         Top             =   408
         Width           =   1152
      End
      Begin VB.CommandButton cmdCollapseAll
         Caption         =   "Collapse All"
         Height          =   312
         Left            =   2340
         TabIndex        =   11
         Top             =   420
         Width           =   1152
      End
      Begin VB.CommandButton cmdExpandAll
         Caption         =   "Expand All"
         Height          =   312
         Left            =   2328
         TabIndex        =   10
         Top             =   72
         Width           =   1152
      End
      Begin VB.CommandButton cmdSelect
         Caption         =   "Select"
         Height          =   312
         Left            =   4824
         TabIndex        =   9
         Top             =   48
         Width           =   1152
      End
      Begin VB.TextBox txtCollapse
         Height          =   288
         Left            =   48
         TabIndex        =   8
         Text            =   "1"
         Top             =   420
         Width           =   588
      End
      Begin VB.CommandButton cmdCollapse
         Caption         =   "Collapse"
         Height          =   312
         Left            =   732
         TabIndex        =   7
         Top             =   408
         Width           =   1152
      End
      Begin VB.TextBox txtExpand
         Height          =   288
         Left            =   48
         TabIndex        =   6
         Text            =   "1"
         Top             =   72
         Width           =   588
      End
      Begin VB.CommandButton cmdExpand
         Caption         =   "Expand"
         Height          =   312
         Left            =   732
         TabIndex        =   5
         Top             =   60
         Width           =   1152
      End
   End
   Begin VB.TextBox Text1
      Height          =   1392
      Left            =   540
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   3
      Top             =   3756
      Visible         =   0   'False
      Width           =   5748
   End
   Begin VB.PictureBox picHeader
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   444
      Left            =   390
      Picture         =   "frmMain.frx":0000
      ScaleHeight     =   444
      ScaleWidth      =   4620
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   30
      Width           =   4620
   End
   Begin ThreadViewAX.ThreadView ThreadView1
      Height          =   1248
      Left            =   1116
      TabIndex        =   15
      Top             =   1188
      Width           =   4464
      _ExtentX        =   7874
      _ExtentY        =   2201
      BorderStyle     =   1
      ColumnCount     =   0
   End
   Begin ComctlLib.ImageList ImageList1
      Left            =   2796
      Top             =   2652
      _Version        =   65536
      _ExtentX        =   804
      _ExtentY        =   804
      _StockProps     =   1
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   128
      NumImages       =   7
      i1              =   "frmMain.frx":3C56
      i2              =   "frmMain.frx":3E11
      i3              =   "frmMain.frx":3FCC
      i4              =   "frmMain.frx":4187
      i5              =   "frmMain.frx":433E
      i6              =   "frmMain.frx":44F9
      i7              =   "frmMain.frx":46B4
   End
   Begin ComctlLib.StatusBar StatusBar1
      Align           =   2  'Align Bottom
      Height          =   300
      Left            =   0
      TabIndex        =   2
      Top             =   5484
      Width           =   6552
      _Version        =   65536
      _ExtentX        =   11557
      _ExtentY        =   529
      _StockProps     =   68
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   204
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      AlignSet        =   -1  'True
      SimpleText      =   ""
      i1              =   "frmMain.frx":4BAF
   End
   Begin ComctlLib.TabStrip TabStrip1
      Height          =   4776
      Left            =   48
      TabIndex        =   1
      Top             =   588
      Width           =   6468
      _Version        =   65536
      _ExtentX        =   11409
      _ExtentY        =   8424
      _StockProps     =   68
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   204
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ImageList       =   ""
      NumTabs         =   3
      i1              =   "frmMain.frx":4CBB
      i2              =   "frmMain.frx":4E02
      i3              =   "frmMain.frx":4F4D
   End
   Begin VB.Menu mnuPopup
      Caption         =   "PopUp"
      Visible         =   0   'False
      Begin VB.Menu mnuExpand
         Caption         =   "Expand"
      End
      Begin VB.Menu mnuCollapse
         Caption         =   "Collapse"
      End
   End
   Begin VB.Menu mnuHeader
      Caption         =   "HeaderPopUp"
      Visible         =   0   'False
      Begin VB.Menu mnuSortAsc
         Caption         =   "Sort Ascending"
      End
      Begin VB.Menu mnuSortDesc
         Caption         =   "Sort Descending"
      End
   End
Attribute VB_Name = "frmMain"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim FileSys As clscFileSysItems
Dim Contacts As clscContacts
Dim Messages As clscMessages
Dim pnlMsg As Panel
Dim lngCurSect As Long
'This sub reads data from Access database and
'loads it into ThreadView control
Private Sub DiscussionsTree()
With ThreadView1
    .Frozen = True 'Always use frozen!
    'You can also add or remove columns at design-time
    'using property page
    With .Columns
           .Clear
        .Add "Subject", "Subject", 200, vbLeftJustify
        .Add "Sender", "Author", 80, vbLeftJustify
        .Add "DateSent", "Date", 80, vbRightJustify
    End With
    .SortColumn = 1
    Set .ImageList = ImageList1
    'if object with data isn't initialized, do it now
    If Messages Is Nothing Then
        MousePointer = vbHourglass
        pnlMsg = "Loading Jet and retrieving data ..."
        DoEvents 'give status bar time to repaint itself
        Set Messages = New clscMessages
        Messages.Create
    End If
    Set .UserObject = Messages
    .Frozen = False
    MousePointer = vbDefault
    pnlMsg = "Ready"
End With
Text1.Visible = True
picCmdCenter.Visible = False
End Sub
'This sub reads your drive information and
'loads it into ThreadView control
Private Sub FileSysTree()
'Hides/shows controls
Text1.Visible = False
picCmdCenter.Visible = False
With ThreadView1
    .Frozen = True 'Always use frozen!
    'You can also add or remove columns at design-time
    'using property page
    With .Columns
        .Clear
        .Add "Name", "Folder/File Name", 200, vbLeftJustify
        .Add "Size", "Size In Bytes", 80, vbRightJustify
        .Add "DateModified", "Date Of Last Modification", 80, vbRightJustify
    End With
    .SortColumn = 1
    Set .ImageList = ImageList1
    'if object with data isn't initialized, do it now
    If FileSys Is Nothing Then
        MousePointer = vbHourglass
        pnlMsg = "Reading your drive information..."
        DoEvents 'give status bar time to repaint itself
        Set FileSys = New clscFileSysItems
        FileSys.Create "c:\"
    End If
    Set .UserObject = FileSys
    .Frozen = False
End With
MousePointer = vbDefault
pnlMsg = "Ready"
End Sub
'This sub reads data from Access database and
'loads it into ThreadView control
Private Sub ContactsTree()
Text1.Visible = False
picCmdCenter.Visible = True
With ThreadView1
    .Frozen = True 'Always use frozen
    'You can also add or remove columns at design-time
    'using property page
    With .Columns
        .Clear
        .Add "Name", "Contact Name", 200, vbLeftJustify
        .Add "WorkPhone", "Work Phone", 80, vbRightJustify
        .Add "LastMeetingDate", "Last Meeting Date", 80, vbRightJustify
    End With
    .SortColumn = 1
    Set .ImageList = ImageList1
    'if object with data isn't initialized, do it now
    If Contacts Is Nothing Then
        MousePointer = vbHourglass
        pnlMsg = "Loading Jet and retrieving data ..."
        DoEvents 'give status bar time to repaint itself
        Set Contacts = New clscContacts
        Contacts.Create
    End If
    Set .UserObject = Contacts
    .Frozen = False
End With
MousePointer = vbDefault
pnlMsg = "Ready"
End Sub
Private Sub cmdCollapse_Click()
ThreadView1.ThreadLines(txtCollapse).Expanded = False
End Sub
Private Sub cmdCollapseAll_Click()
Dim i As Long
ThreadView1.Frozen = True
    i = i + 1
    ThreadView1.ThreadLines(i).Expanded = False
Loop While ThreadView1.ThreadLines.Count > i
ThreadView1.Frozen = False
End Sub
Private Sub cmdExpand_Click()
ThreadView1.ThreadLines(txtExpand).Expanded = True
End Sub
Private Sub cmdExpandAll_Click()
Dim i As Long
ThreadView1.Frozen = True
    i = i + 1
    ThreadView1.ThreadLines(i).Expanded = True
Loop While ThreadView1.ThreadLines.Count > i
ThreadView1.Frozen = False
End Sub
Private Sub cmdSelect_Click()
ThreadView1.ThreadLines(txtSelect).Selected = True
End Sub
Private Sub cmdDeselect_Click()
ThreadView1.ThreadLines(txtDeselect).Selected = False
End Sub
Private Sub Form_Load()
Set pnlMsg = statusbar1.Panels(1)
FileSysTree
End Sub
Private Sub Form_Resize()
If WindowState = vbMinimized Then Exit Sub
With TabStrip1
    .Width = ScaleWidth - 100
    .Height = ScaleHeight - 1000
End With
With Text1
    If .Visible Then
        .Left = TabStrip1.ClientLeft
        .Width = TabStrip1.ClientWidth
        .Top = TabStrip1.ClientTop + TabStrip1.ClientHeight / 2
        .Height = TabStrip1.ClientHeight / 2

    End If
End With
With picCmdCenter
    If .Visible Then
        .Top = TabStrip1.ClientTop + TabStrip1.ClientHeight - .Height
        .Width = TabStrip1.ClientWidth
    End If
End With
With ThreadView1
    'Always set Frozen to True before making a number of changes
    .Frozen = True
    .Left = TabStrip1.ClientLeft
    .Top = TabStrip1.ClientTop
    .Width = TabStrip1.ClientWidth
    Select Case TabStrip1.SelectedItem.Key
        Case "Contacts" 'Contacts
            .Height = TabStrip1.ClientHeight - picCmdCenter.Height
        Case "Discussions" 'Discussions
            .Height = TabStrip1.ClientHeight / 2
        Case Else
            .Height = TabStrip1.ClientHeight
    End Select
    .Frozen = False
End With
picHeader.Left = (ScaleWidth - picHeader.Width) / 2
End Sub
Private Sub mnuCollapse_Click()
ThreadView1.SelectedItem.Expanded = False
End Sub
Private Sub mnuExpand_Click()
ThreadView1.SelectedItem.Expanded = True
End Sub
Private Sub mnuSortAsc_Click()
ThreadView1.SortColumn = lngCurSect
ThreadView1.SortOrder = thvSortAsc
End Sub
Private Sub mnuSortDesc_Click()
ThreadView1.SortColumn = lngCurSect
ThreadView1.SortOrder = thvSortDesc
End Sub
Private Sub TabStrip1_Click()
Select Case TabStrip1.SelectedItem.Key
    Case "FileSys": FileSysTree
    Case "Contacts": ContactsTree
    Case "Discussions": DiscussionsTree
End Select
Form_Resize
End Sub
Private Sub ThreadView1_Collapse(Line As ThreadLine)
'You can use this event to unload child objects:
'Set Line.object.Children = Nothing
'Keep your memory tidy!
End Sub
Private Sub ThreadView1_HeaderClick(Column As ThreadViewAX.Column)
With ThreadView1
    If .SortColumn = Column.Index Then
        .SortOrder = Abs(Not CBool(.SortOrder))
      Else
        .SortColumn = Column.Index
    End If
End With
End Sub
Private Sub ThreadView1_HeaderMouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer, lngWidth As Long
If (Button And vbRightButton) = vbRightButton Then
    'determines which column header was pressed
    For i = 1 To ThreadView1.Columns.Count
        lngWidth = lngWidth + ThreadView1.Columns(i).Width
        If lngWidth >= X Then
            lngCurSect = i
            Exit For
        End If
    Next i
    PopupMenu mnuHeader, vbPopupMenuRightButton
End If
End Sub
Private Sub ThreadView1_ItemClick(Line As ThreadLine)
If TabStrip1.SelectedItem.Key = "Discussions" Then
    Text1 = Line.object.Message
End If
End Sub
Private Sub ThreadView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And vbRightButton Then
    If ThreadView1.SelectedItem.object.HasChildren Then
        mnuExpand.Enabled = Not ThreadView1.SelectedItem.Expanded
        mnuCollapse.Enabled = ThreadView1.SelectedItem.Expanded
      Else
        mnuExpand.Enabled = False
        mnuCollapse.Enabled = False
    End If
    PopupMenu mnuPopup
End If
End Sub